home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
PASCAL
/
0188.ZIP
/
ITRMMISC.INC
< prev
next >
Wrap
Text File
|
1985-02-20
|
2KB
|
86 lines
procedure scan(var extend : boolean; var code : byte);
{
Uses MSDOS service 7 to get a keystroke w/o echo. Sets 'extend' true
for extended codes from PC-Clone keyboards, and returns ASCII/Scan code
in 'code'
}
const
SERVICE_7 = $700; {set CPU register AX for DOS service 7}
MASK_AH = $FF; {service 7 returns code in AL}
type
reg88 = record
ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
end;
var
r : reg88;
c : integer;
begin
r.ax := SERVICE_7;
MsDos(r);
code := r.ax and MASK_AH;
extend := false;
if code = 0 then
begin
extend := true;
MsDos(r);
code := r.ax and MASK_AH
end
end;
function exists(fname : bigstring) : boolean;
var
f : file;
begin
assign(f, fname);
{$I-}
reset(f);
{$I+}
if IOresult = 0 then
begin
exists := true;
close(f)
end
else
exists := false
end;
procedure supcase(var s);
var
ss : bigstring absolute s;
i : integer;
begin
for i := 1 to length(ss) do
ss[i] := upcase(ss[i])
end;
type
DiskFile = file of byte;
stream = ^diskfile;
function fopen(var name : bigstring; mode : char) : stream;
Var
ls : stream;
FileExists : boolean;
begin
ls := NIL;
mode := upcase(mode);
FileExists := exists(name);
if FileExists or (mode = 'W') then
begin
new(ls);
assign(ls^,name)
end;
case mode of
'R', 'A' : begin
if FileExists then
begin
reset(ls^);
if mode = 'A' then
seek(ls^,filesize(ls^))
end
end;
'W' : rewrite(ls^);
end;
fopen := ls
end;